home *** CD-ROM | disk | FTP | other *** search
/ PD ROM 1 / PD ROM Volume I - Macintosh Software from BMUG (1988).iso / Programming / Programming Tools / XCMDs / GetDocs.p < prev    next >
Encoding:
Text File  |  1987-08-17  |  4.1 KB  |  159 lines  |  [TEXT/ttxt]
  1. {$R-}
  2.  
  3. (*
  4.     GetDocs -- update document representatives stack
  5.     By Dan Winkler.  DO NOT call the author!  Contact Apple Developer 
  6.     Support on AppleLink "MacDTS" or on MCI "MacTech".
  7.  
  8.     ©Apple Computer, Inc. 1987
  9.     All Rights Reserved.
  10.  
  11.     pascal GetDocs.p
  12.     link -m ENTRYPOINT -o {BOOT}documents -rt XCMD=2 -sn Main=GetDocs GetDocs.p.o ∂
  13.       {MPW}Libraries:Interface.o {MPW}PLibraries:PasLib.o
  14.         {boot}hypercard
  15.  
  16. *)
  17.  
  18. {$S GetDocs }     { Segment name must be the same as the command name. }
  19.  
  20. UNIT DummyUnit;
  21.  
  22. INTERFACE
  23.  
  24. USES MemTypes, QuickDraw, OSIntf, ToolIntf, HyperXCmd;
  25.  
  26. PROCEDURE EntryPoint(paramPtr: XCmdPtr);
  27.     
  28. IMPLEMENTATION
  29.  
  30. TYPE Str31 = String[31];
  31.  
  32. PROCEDURE GetDocs(paramPtr: XCmdPtr);                             FORWARD;
  33.  
  34.   PROCEDURE EntryPoint(paramPtr: XCmdPtr);
  35.   BEGIN
  36.     GetDocs(paramPtr);
  37.   END;
  38.  
  39.   PROCEDURE GetDocs(paramPtr: XCmdPtr);
  40.   VAR pathName: Str255;
  41.       fileName:    Str255;
  42.       paramBlock: CInfoPBRec;
  43.       deskTop: INTEGER;
  44.       
  45.     {$I XCmdGlue.inc }
  46.     
  47.     FUNCTION CardExists: BOOLEAN;
  48.     { do we already have a card for this document? }
  49.     VAR result: Handle;
  50.         i: INTEGER;
  51.     strippedName: Str255;
  52.     BEGIN
  53.       strippedName := fileName;
  54.       FOR i := 1 TO Length(strippedName) DO  { strip quotes }
  55.         IF strippedName[i] = '"' THEN strippedName[i] := ' ';
  56.       SendCardMessage(Concat('find "',strippedName,'" in field "Name"'));
  57.       result := EvalExpr('the result');
  58.       CardExists := result^^ = 0;
  59.       DisposHandle(result);
  60.     END;
  61.     
  62.     PROCEDURE PutField(fieldName,fieldVal: Str255);
  63.     VAR h: Handle;
  64.     BEGIN
  65.       h := PasToZero(fieldVal);
  66.       SetFieldByName(FALSE,fieldName,h);
  67.       DisposHandle(h);
  68.     END;
  69.     
  70.     FUNCTION OSTypeToStr(str: OSType): Str31;
  71.     VAR result: Str31;
  72.     BEGIN
  73.       result[0] := CHR(4);
  74.       BlockMove(@str,Pointer(ORD(@result)+1),4);
  75.       OSTypeToStr := result;
  76.     END;
  77.       
  78.     PROCEDURE DoOneFile;
  79.     TYPE PasPtr = ^Str255;
  80.     VAR cmnt: Handle;
  81.     BEGIN
  82.       IF CardExists THEN EXIT(DoOneFile);
  83.       SendCardMessage('go to last card');
  84.       SendCardMessage('doMenu "New Card"');
  85.       PutField('Name',fileName);
  86.       PutField('Where',pathName);
  87.       PutField('Type',OSTypeToStr(paramBlock.ioFlFndrInfo.fdType));
  88.       PutField('Creator',OSTypeToStr(paramBlock.ioFlFndrInfo.fdCreator));
  89.       PutField('Created',LongToStr(paramBlock.ioFlCrDat));
  90.       SendCardMessage('convert field "Created" to long date');
  91.       PutField('Modified',LongToStr(paramBlock.ioFlMdDat));
  92.       SendCardMessage('convert field "Modified" to long date');
  93.       PutField('Size',Concat(LongToStr((paramBlock.ioFlPyLen+paramBlock.ioFLRPyLen+1023) DIV 1024),' K'));
  94.       cmnt := GetResource('FCMT',paramBlock.ioFlXFndrInfo.fdComment);
  95.       IF cmnt <> NIL THEN PutField('Notes',PasPtr(cmnt^)^);
  96.       (***
  97.       ioFlXFndrInfo.fdIconID
  98.       ***)
  99.     END;
  100.       
  101.     PROCEDURE DoOnePath;
  102.     VAR fileIndex: INTEGER;
  103.     result:    INTEGER;
  104.     wdParams: WDPBRec;
  105.     BEGIN
  106.       { set up working directory }
  107.       ZeroBytes(@wdParams,SizeOf(wdParams));
  108.       WITH wdParams DO
  109.     BEGIN
  110.       ioNamePtr := @pathName;
  111.       ioWDProcID := $4552494B;  { 'ERIK' so finder will delete later }
  112.       ioWDDirID := 2;
  113.     END;
  114.       SetResLoad(FALSE);
  115.       SetResLoad(TRUE);
  116.       result := PBOpenWD(@wdParams,FALSE);
  117.       IF result <> 0 THEN EXIT(DoOnePath);
  118.  
  119.       { step through each file in this directory }
  120.       fileIndex := 1;
  121.       REPEAT
  122.     ZeroBytes(@paramBlock,SizeOf(paramBlock));
  123.     WITH paramBlock DO
  124.       BEGIN
  125.         fileName := '';
  126.         ioNamePtr := @fileName;
  127.         ioVRefNum := wdParams.ioVRefNum;
  128.         ioFDirIndex := fileIndex;
  129.       END;
  130.     result := PBGetCatInfo(@paramBlock,FALSE);
  131.     IF (result = 0) 
  132.     AND NOT BitTst(@paramBlock.ioFlAttrib,3) 
  133.     (** AND (paramBlock.ioFlFndrInfo.fdType <> 'APPL') **)
  134.     AND (paramBlock.ioFlFndrInfo.fdType <> 'FNDR') 
  135.     THEN DoOneFile;
  136.     fileIndex := fileIndex + 1;
  137.       UNTIL result = fnfErr;
  138.     END;
  139.  
  140.   BEGIN
  141.     WITH paramPtr^ DO
  142.       BEGIN
  143.         IF paramCount < 1 THEN
  144.       BEGIN
  145.         returnValue := PasToZero('search which folder?');
  146.         EXIT(GetDocs);
  147.       END;
  148.     ReturnToPas(params[1]^,pathName);
  149.         deskTop := OpenRFPerm('DeskTop',0,fsRdPerm);
  150.     DoOnePath;
  151.     CloseResFile(deskTop);
  152.       END;
  153.   END;
  154.  
  155. END.
  156.  
  157.  
  158.  
  159.